Mammals and Water Availability: Study Area

The aim of this study is to assess the effect of water scarcity on the distribution of an African herbivore guild along the Ruaha River, TZ

Stephanie Kramer-Schadt https://ecodynizw.github.io (Leibniz Institute for Zoo and Wildlife Research)https://izw-berlin.de/en/ , Cédric Scherer https://cedricscherer.com (Leibniz Institute for Zoo and Wildlife Research)https://izw-berlin.de/en/
2023-10-23

Setup

invisible(sapply(
  list("d6", "sf", "dplyr", "readr", "tidyr", "terra" , "ggplot2", "stars", "ggspatial", 
       "rcartocolor", "colorspace", "systemfonts", "patchwork", "here", "ggdensity"), 
  library, character.only = TRUE, logical.return = TRUE
))

# ggplot theme
theme_set(theme_d6(legend = c(.48,.95)))
theme_update(
  axis.text = element_text(),
  legend.text = element_text(size = rel(.95)),
  legend.key.height = unit(.2, "lines"),
  legend.key.width = unit(1.5, "lines"),
  legend.position = c(.48, .95),
  legend.direction = "horizontal"
)

Figure 1: Map Study Site

Data

## park boundary
park_bounds_ruaha_utm <- 
  st_read(here("data-proc", "geo-proc", "park_bounds_ruaha_32636_edited.gpkg"))

## normalized difference vegetation index
ndvi <- rast(here("data-proc", "geo-proc", "ndvi_201307_crop_32636.tif"))
# ndvi <- rast(here("data-proc", "geo-proc", "ndvi_201310_crop_32636.tif"))

## transects
transects <- 
  read.table(here("data-proc","stommel_mastertable_20230127.txt"), 
                  header = TRUE, dec = ".", na.strings = "NA", stringsAsFactors = TRUE) |> 
  st_as_sf(coords = c("lon", "lat"), crs = 4326) |> 
  st_transform(st_crs(ndvi))

transects_buffer <- transects |> st_buffer(2000)

transect_ids <- 
  tibble::tribble(
    ~id,  ~lon,   ~lat,
    "5",  35.22,  -7.4,
    "10", 35.08,  -7.55,
    "9",  35.022, -7.62,
    "4",  34.93,  -7.63,  
    "8",  34.89,  -7.76,
    "3",  34.77,  -7.73,  
    "7",  34.77,  -7.835,
    "2",  34.65,  -7.753, 
    "6",  34.67,  -7.88,
    "1",  34.54,  -7.85
  ) |> 
  st_as_sf(coords = c("lon", "lat"), crs = 4326)

ndvi_c <- crop(ndvi, transects_buffer)
values(ndvi_c) <- values(ndvi_c) / 10000


## rivers
rivers_ruaha_utm <- st_read(here("data-proc", "geo-proc", "rivers_osm_ruaha_32636.gpkg"))

rivers_ruaha_utm_c <- st_crop(rivers_ruaha_utm, transects_buffer)

rivers_ruaha_utm_sub <- 
  rivers_ruaha_utm_c |> 
  ## remove rivers that are not considered
  filter(
    !(substr(osm_id, 1, 4) %in% c("4944", "3629", "9659", "3346")),
    osm_id != "378460637"
  ) |> 
  ## add type information to color based on main vs sand rivers
  mutate(
    type = if_else(name %in% c("Great Ruaha", "Jongomero"), "main", "sand"),
    type = factor(type, levels = c("pool", "sand", "main", "transect"))
  )


## pools
pools <- 
  vroom::vroom(here("data-proc", "ruaha_spring_pools.csv")) |> 
  add_row(WAT_ID = 0000, ID_POOL = "Legend", LON = 35.03, LAT = -7.378) |> 
  st_as_sf(coords = c("LON", "LAT"), crs = 4326) |> 
  st_transform(st_crs(park_bounds_ruaha_utm))


## bounding box
bbox <- st_bbox(ndvi_c)

Map

map <- 

  ggplot() +
   
  ## ndvi
  geom_stars(data = st_as_stars(ndvi_c), alpha = 1) +
  scale_fill_continuous_sequential(
    trans = "exp", palette = "Terrain 2", begin = .1, guide = "none",
    breaks = c(seq(-.4, .8, by = .2)), limits = c(-.4, NA)
  ) +

  ggnewscale::new_scale_fill() +
  
  ## river outlines
  geom_sf(data = st_buffer(rivers_ruaha_utm_sub, 500), aes(fill = type), lwd = 0) +
  scale_fill_manual(
    values = c("transparent", "#ebcc3b", "#a1c2e2", "black"), guide = guide_legend(reverse = TRUE), 
    labels = c("Pools", "Sand river  ", "Main river   ", "Transects   "), name = NULL, drop = FALSE
  ) +
  
  ## park boundaries
  geom_sf(
    data = park_bounds_ruaha_utm, color = "grey35", fill = NA, 
    lwd = .6, linetype = "32", lineend = "round"
  ) +

  ## rivers
  geom_sf(data = rivers_ruaha_utm_sub, aes(color = type), lwd = .8) +
  scale_color_manual(
    values = c("transparent", "#977d16", "#1568b8", "white"), guide = guide_legend(reverse = TRUE), 
    labels = c("Pools", "Sand river  ", "Main river   ", "Transects   "), name = NULL, drop = FALSE
  ) +
    
  ## transects
  geom_sf(data = transects, color = "black", size = 1.5) +
  geom_sf(data = transects, color = "white", size = .05) +
  geom_sf_text(
    data = transect_ids, aes(label = id), 
    size = 5, family = "PT Serif", fontface = "bold", color = "gray10"
  ) +
  
  ## pools
  geom_sf(data = pools, size = 10, shape = "★", color = "white") +
  geom_sf(data = pools, size = 6, shape = "★", color = "firebrick") +

  ## north arrow + scaale bar
  ggspatial::annotation_scale(
    location = "br", text_family = "PT Sans", text_cex = .9, width_hint = .4,
    pad_x = unit(4.5, "lines"), pad_y = unit(.35, "cm"), text_pad = unit(.35, "cm")
  ) +
  ggspatial::annotation_north_arrow(location = "br") +
  
  ## bounding box
  coord_sf(expand = FALSE, xlim = bbox[c(1,3)], ylim = bbox[c(2,4)]) +
  
  ## axis titles
  labs(x = "Longitude", y = "Latitude")


park <-
  ggplot() +
   
  ## park boundaries
  geom_sf(
    data = park_bounds_ruaha_utm, color = "grey35", fill = "white",
    lwd = .5, linetype = "32", lineend = "round"
  ) +

  ## rivers
  geom_sf(data = rivers_ruaha_utm_sub, aes(color = type), lwd = .5) +
  scale_color_manual(
    values = c("#977d16", "#1568b8"), guide = "none"
  ) +
  
  ## bounding box
  geom_sf(data = st_as_sfc(bbox), color = "black", fill = NA, linewidth = 1.2) +
  
  ## projection
  coord_sf(crs = st_crs(park_bounds_ruaha_utm)) +
  
  ## theming
  theme_void() +
  theme(panel.background = element_rect(fill = NA, color = NA))


globe <- 
  d6berlin::globe(
    col_earth = "grey80", #"#B7D19D",
    col_water = "white", #"#A9C9EB",
    bg = TRUE,
    center = c(34.93544, -0.68140)
  )
  

map_globe <- map + 
  inset_element(park, left = 0, right = .21, bottom = .5, top = .75) +
  inset_element(globe, left = 0, right = .21, bottom = .76, top = .99)

map_globe
ggsave(here("plots", "Fig1_study_area.png"), 
       width = 10, height = 7.67, dpi = 600, bg = "white") 

Session Info
[1] "2023-10-23 17:55:37 CEST"
git2r::repository()
Local:    master C:/Users/scherer/PopDynCloud/Projects/mammals_africa_transects_schmied_c
Remote:   master @ origin (https://github.com/EcoDynIZW/mammals_africa_transects_schmied.git)
Head:     [09e80cd] 2023-10-23: add data + script map
R version 4.3.0 (2023-04-21 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19041)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=C                             

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
 [1] ggdensity_1.0.0   here_1.0.1        patchwork_1.1.2  
 [4] systemfonts_1.0.4 colorspace_2.1-0  rcartocolor_2.1.1
 [7] ggspatial_1.1.8   stars_0.6-1       abind_1.4-5      
[10] ggplot2_3.4.2     terra_1.7-29      tidyr_1.3.0      
[13] readr_2.1.4       dplyr_1.1.2       sf_1.0-13        
[16] d6_0.1.0.4       

loaded via a namespace (and not attached):
 [1] DBI_1.1.3          s2_1.1.4           remotes_2.4.2     
 [4] rlang_1.1.1        magrittr_2.0.3     git2r_0.32.0      
 [7] e1071_1.7-13       compiler_4.3.0     callr_3.7.3       
[10] vctrs_0.6.2        stringr_1.5.0      profvis_0.3.8     
[13] wk_0.7.3           pkgconfig_2.0.3    crayon_1.5.2      
[16] fastmap_1.1.1      ellipsis_0.3.2     lwgeom_0.2-13     
[19] utf8_1.2.3         promises_1.2.0.1   rmarkdown_2.22    
[22] sessioninfo_1.2.2  tzdb_0.4.0         ps_1.7.5          
[25] ragg_1.2.5         purrr_1.0.1        bit_4.0.5         
[28] xfun_0.39          cachem_1.0.8       jsonlite_1.8.5    
[31] highr_0.10         later_1.3.1        parallel_4.3.0    
[34] prettyunits_1.1.1  R6_2.5.1           bslib_0.5.0       
[37] stringi_1.7.12     pkgload_1.3.2      jquerylib_0.1.4   
[40] Rcpp_1.0.10        knitr_1.43         usethis_2.2.0     
[43] httpuv_1.6.11      tidyselect_1.2.0   rstudioapi_0.14   
[46] yaml_2.3.7         codetools_0.2-19   miniUI_0.1.1.1    
[49] processx_3.8.1     pkgbuild_1.4.1     tibble_3.2.1      
[52] shiny_1.7.4        withr_2.5.0        evaluate_0.21     
[55] desc_1.4.2         units_0.8-2        proxy_0.4-27      
[58] urlchecker_1.0.1   pillar_1.9.0       KernSmooth_2.23-20
[61] generics_0.1.3     vroom_1.6.3        rprojroot_2.0.3   
[64] hms_1.1.3          munsell_0.5.0      scales_1.2.1      
[67] xtable_1.8-4       class_7.3-21       glue_1.6.2        
[70] tools_4.3.0        ggnewscale_0.4.9   d6berlin_1.0.0    
[73] distill_1.6        fs_1.6.2           grid_4.3.0        
[76] devtools_2.4.5     cli_3.6.1          textshaping_0.3.6 
[79] fansi_1.0.4        downlit_0.4.2      gtable_0.3.3      
[82] sass_0.4.6         digest_0.6.31      classInt_0.4-9    
[85] htmlwidgets_1.6.2  farver_2.1.1       memoise_2.0.1     
[88] htmltools_0.5.5    lifecycle_1.0.3    mime_0.12         
[91] bit64_4.0.5        MASS_7.3-58.4